home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / MacPerl 5.1.3 / Mac_Perl_513_src / perl5.002 / lib / GD.pm < prev    next >
Encoding:
Perl POD Document  |  1997-01-15  |  6.1 KB  |  247 lines  |  [TEXT/MPS ]
  1. package GD;
  2.  
  3. # Copyright 1995 Lincoln D. Stein.  See accompanying README file for
  4. # usage information
  5.  
  6. require Exporter;
  7. require DynaLoader;
  8. require AutoLoader;
  9.  
  10. @ISA = qw(Exporter DynaLoader);
  11. # Items to export into callers namespace by default. Note: do not export
  12. # names by default without a very good reason. Use EXPORT_OK instead.
  13. # Do not simply export all your public functions/methods/constants.
  14. @EXPORT = qw(
  15.         gdBrushed
  16.         gdDashSize
  17.         gdMaxColors
  18.         gdStyled
  19.         gdStyledBrushed
  20.         gdTiled
  21.         gdTransparent
  22.         gdSmallFont
  23.         gdLargeFont
  24.         gdMediumBoldFont
  25.         gdTinyFont
  26. );
  27. sub AUTOLOAD {
  28.     # This AUTOLOAD is used to 'autoload' constants from the constant()
  29.     # XS function.  If a constant is not found then control is passed
  30.     # to the AUTOLOAD in AutoLoader.
  31.  
  32.     local($constname);
  33.     ($constname = $AUTOLOAD) =~ s/.*:://;
  34.     $val = constant($constname, @_ ? $_[0] : 0);
  35.     if ($! != 0) {
  36.         if ($! =~ /Invalid/) {
  37.             $AutoLoader::AUTOLOAD = $AUTOLOAD;
  38.             goto &AutoLoader::AUTOLOAD;
  39.         }
  40.         else {
  41.             ($pack,$file,$line) = caller;
  42.             die "Your vendor has not defined GD macro $pack\:\:$constname, used at $file line $line.\n";
  43.         }
  44.     }
  45.     eval "sub $AUTOLOAD { $val }";
  46.     goto &$AUTOLOAD;
  47. }
  48.  
  49. bootstrap GD;
  50.  
  51. # Preloaded methods go here.
  52. sub GD::gdSmallFont {
  53.     return &GD::Font::Small;
  54. }
  55.  
  56. sub GD::gdLargeFont {
  57.     return &GD::Font::Large;
  58. }
  59.  
  60. sub GD::gdMediumBoldFont {
  61.     return &GD::Font::MediumBold;
  62. }
  63.  
  64. sub GD::gdTinyFont {
  65.     return &GD::Font::Tiny;
  66. }
  67.  
  68. # This is a C callback
  69. sub GD::fileno {
  70.     local($fh) = @_;
  71.     local($package) = caller;
  72.     return fileno "$package\:\:$fh";
  73. }
  74.  
  75. # This handles the Gif method
  76. sub GD::Image::gif {
  77.     my $self = shift;
  78.     if ($^O eq 'MacOS') {
  79.         open(GIF, ">GD.tmp.GIF");
  80.         my($return,$scalar);
  81.         $self->__Gif(fileno GIF);
  82.         close GIF;
  83.         open(GIF, "<GD.tmp.GIF");
  84.         while(read(GIF,$scalar,1024)) {
  85.             $return .= $scalar;
  86.         }
  87.         close GIF;
  88.         unlink "GD.tmp.GIF";
  89.         
  90.         return $return;
  91.     } else {
  92.         my $pid = open(GIF,"-|");
  93.         my($return,$scalar);
  94.         if ($pid) {                     # child is going to pipe some stuff to us
  95.             while(read(GIF,$scalar,1024)) {
  96.                 $return .= $scalar;
  97.             }
  98.             close GIF;
  99.             return $return;
  100.         } else {                        # we are the child
  101.            $self->__Gif(fileno STDOUT);
  102.            close STDOUT;
  103.            exit 0;
  104.         }
  105.     }
  106. }
  107.  
  108. # This handles creation of gd data
  109. sub GD::Image::gd {
  110.     my $self = shift;
  111.     if ($^O eq 'MacOS') {
  112.         open(GGD, ">GD.tmp.gd");
  113.         my($return,$scalar);
  114.         $self->__Gd(fileno GGD);
  115.         close GGD;
  116.         open(GGD, "<GD.tmp.gd");
  117.         while(read(GGD,$scalar,1024)) {
  118.             $return .= $scalar;
  119.         }
  120.         close GGD;
  121.         unlink "GD.tmp.gd";
  122.         
  123.         return $return;
  124.     } else {
  125.         my $pid = open(GGD,"-|");
  126.         my($return,$scalar);
  127.         if ($pid) {                     # child is going to pipe some stuff to us
  128.             while(read(GGD,$scalar,1024)) {
  129.                 $return .= $scalar;
  130.             }
  131.             close GGD;
  132.             return $return;
  133.         } else {                        # we are the child
  134.            $self->__Gd(fileno STDOUT);
  135.            close STDOUT;
  136.            exit 0;
  137.         }
  138.     }
  139. }
  140.  
  141. ### The polygon object ###
  142. # create a new polygon
  143. sub GD::Polygon::new {
  144.     return bless { 'length'=>0,'points'=>[] },GD::Polygon;
  145. }
  146.  
  147. # automatic destruction of the polygon
  148. sub GD::Polygon::DESTROY {
  149.     my $self = shift;
  150.     undef $self->{'points'};
  151. }
  152.  
  153. # add an x,y vertex to the polygon
  154. sub GD::Polygon::addPt {
  155.     my($self,$x,$y) = @_;
  156.     push(@{$self->{'points'}},[$x,$y]);
  157.     $self->{'length'}++;
  158. }
  159.  
  160. # get a vertex
  161. sub GD::Polygon::getPt {
  162.     my($self,$index) = @_;
  163.     return () unless ($index>=0) && ($index<$self->{'length'});
  164.     return @{$self->{'points'}->[$index]};
  165. }
  166.  
  167. # change the value of a vertex
  168. sub GD::Polygon::setPt {
  169.     my($self,$index,$x,$y) = @_;
  170.     unless (($index>=0) && ($index<$self->{'length'})) {
  171.         warn "Attempt to set an undefined polygon vertex";
  172.         return undef;
  173.     }
  174.     @{$self->{'points'}->[$index]} = ($x,$y);
  175.     1;
  176. }
  177.  
  178. # return the total number of vertices
  179. sub GD::Polygon::length {
  180.     my $self = shift;
  181.     return $self->{'length'};
  182. }
  183.  
  184. # return the array of vertices.
  185. # each vertex is an two-member (x,y) array
  186. sub GD::Polygon::vertices {
  187.     my $self = shift;
  188.     return @{$self->{'points'}};
  189. }
  190.  
  191. # return the bounding box of the polygon
  192. # (smallest rectangle that contains it)
  193. sub GD::Polygon::bounds {
  194.     my $self = shift;
  195.     my($top,$bottom,$left,$right) = @_;
  196.     $top =    99999999;
  197.     $bottom =-99999999;
  198.     $left =   99999999;
  199.     $right = -99999999;
  200.     my $v;
  201.     foreach $v ($self->vertices) {
  202.         $left = $v->[0] if $left > $v->[0];
  203.         $right = $v->[0] if $right < $v->[0];
  204.         $top = $v->[1] if $top > $v->[1];
  205.         $bottom = $v->[1] if $bottom < $v->[1];
  206.     }
  207.     return ($left,$top,$right,$bottom);
  208. }
  209.  
  210. # delete a vertex, returning it, just for fun
  211. sub GD::Polygon::delete {
  212.     local($index) = @_;
  213.     local($vertex) = splice(@{$self->{'points'}},$index,1);
  214.     return @$vertex;
  215. }
  216.  
  217. # translate the polygon in space by deltaX and deltaY
  218. sub GD::Polygon::offset {
  219.     my($self,$dh,$dv) = @_;
  220.     my $size = $self->length;
  221.     my($i);
  222.     for ($i=0;$i<$size;$i++) {
  223.         my($x,$y)=$self->getPt($i);
  224.         $self->setPt($i,$x+$dh,$y+$dv);
  225.     }
  226. }
  227.  
  228. # map the polygon from sourceRect to destRect,
  229. # translating and resizing it if necessary
  230. sub GD::Polygon::map {
  231.     my($self,$srcL,$srcT,$srcR,$srcB,$destL,$destT,$destR,$destB) = @_;
  232.     my($factorV) = ($destB-$destT)/($srcB-$srcT);
  233.     my($factorH) = ($destR-$destL)/($srcR-$srcL);
  234.     my($vertices) = $self->length;
  235.     my($i);
  236.     for ($i=0;$i<$vertices;$i++) {
  237.         my($x,$y) = $self->getPt($i);
  238.         $x = int($destL + ($x - $srcL) * $factorH);
  239.         $y = int($destT + ($y - $srcT) * $factorV);
  240.         $self->setPt($i,$x,$y);
  241.     }
  242. }
  243.  
  244. # Autoload methods go after __END__, and are processed by the autosplit program.
  245. 1;
  246. __END__
  247.